home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / The World of Computer Software.iso / snxt_100.zip / SYSNXT.PAS < prev    next >
Pascal/Delphi Source File  |  1991-01-19  |  9KB  |  283 lines
  1. Program SysopNext;
  2.  
  3. Uses
  4.   Crt, Dos;
  5. Const
  6.   Pgmid = 'SYSNXT v1.00 19jan91 MWBJR Enterprise 1:273/701.0 (215)641-0270';
  7. Var
  8.   Msr : Registers;
  9.   KeyInput : Char;
  10.   ATimer, AExit, APos, CTimer, CExit, CPos, NTimer, NExit, NPos, STimer, SExit, SPos : Byte;
  11.   Beep, CapsLock, NumLock, ScrollLock : Boolean;
  12.   Count, KeyReturn : Byte;
  13. {========================================================================}
  14. Function UpperString(InString : String) : String;
  15.   Var
  16.     Usb : Byte;
  17.   Begin
  18.     For Usb := 1 To Length(InString) Do InString[Usb] := Upcase(InString[Usb]);
  19.     UpperString := InString;
  20.   End;
  21. {========================================================================}
  22. Function MyVal(InString : String) : Integer;
  23.   Var
  24.     OutVal, Result : Integer;
  25.   Begin
  26.     Val(InString,OutVal,Result);
  27.     MyVal := OutVal;
  28.   End;
  29. {========================================================================}
  30. Function MyStr(InNum : Integer) : String;
  31.   Var
  32.     OutString : String;
  33.   Begin
  34.     Str(InNum,OutString);
  35.     MyStr := OutString;
  36.   End;
  37. {========================================================================}
  38. Function KeyTimeOut(TimeToCount : Byte) : Byte;
  39.   Const
  40.     BkspString = #8+#8+#8;
  41.   Var
  42.     SecondCounter : LongInt;
  43.     TempKey : Byte;
  44.   Begin
  45.     Repeat
  46.       Write(MyStr(TimeToCount)+' '+#8+Copy(BkspString,1,Length(MyStr(TimeToCount))));
  47.       If Beep Then
  48.       Begin
  49.         Sound(500);
  50.         Delay(100);
  51.         NoSound;
  52.       End;
  53.       Delay(1000);
  54.       Dec(TimeToCount);
  55.       If TimeToCount = 0 Then
  56.       Begin
  57.         KeyTimeOut := 0;
  58.         Exit;
  59.       End;
  60.     Until KeyPressed;
  61.     TempKey := Ord(ReadKey);
  62.     If TempKey = 27 Then TempKey := 0;
  63.     KeyTimeOut := TempKey;
  64.   End;
  65. {=======================================================================}
  66. Procedure ParseCommandLine;
  67.   Var
  68.     Pclb : Byte;
  69.     Parm : Array[1..3] Of String;
  70.   Begin
  71.     If ParamCount = 0 Then
  72.     Begin
  73.       WriteLn;
  74.       WriteLn('SYSNXT ssskeee [ssskeee] [ssskeee]');
  75.       WriteLn('       sss = seconds to wait for timeout 0-255');
  76.       WriteLn('          k = key to activate timeout (C)apsLock (N)umLock (S)crollLock');
  77.       WriteLn('           eee = errorlevel to exit if any key is pressed 0-255');
  78.       WriteLn;
  79.       WriteLn('Example: SYSNXT 30S5 = Wait 30 seconds for any key if scroll lock is on.');
  80.       WriteLn('                       If key is pressed exit with errorlevel 5.');
  81.       WriteLn;
  82.     End
  83.     Else
  84.     Begin
  85.       ATimer := 0; AExit := 0; APos := 0;
  86.       CTimer := 0; CExit := 0; CPos := 0;
  87.       NTimer := 0; NExit := 0; NPos := 0;
  88.       STimer := 0; SExit := 0; SPos := 0;
  89.       Beep := False;
  90.       For Pclb := 1 To ParamCount Do
  91.       Begin
  92.         Parm[Pclb] := ParamStr(Pclb);
  93.         If (Pos('A',Parm[Pclb]) > 0) Or
  94.            (Pos('C',Parm[Pclb]) > 0) Or
  95.            (Pos('N',Parm[Pclb]) > 0) Or
  96.            (Pos('S',Parm[Pclb]) > 0) Then Beep := True;
  97.         Parm[Pclb] := UpperString(ParamStr(Pclb));
  98.         If (Pos('A',Parm[Pclb]) > 0) Or
  99.            (Pos('C',Parm[Pclb]) > 0) Or
  100.            (Pos('N',Parm[Pclb]) > 0) Or
  101.            (Pos('S',Parm[Pclb]) > 0) Then
  102.         Begin
  103.           If Pos('A',Parm[Pclb]) > 0 Then
  104.           Begin
  105.             Apos := Pclb;
  106.             If Pos('A',Parm[Pclb]) > 1 Then
  107.             Begin
  108.               ATimer := MyVal(Copy(Parm[Pclb],1,Pos('A',Parm[Pclb])-1));
  109.             End;
  110.             If Length(Parm[Pclb]) > Pos('A',Parm[Pclb]) Then
  111.             Begin
  112.               AExit := MyVal(Copy(Parm[Pclb],Pos('A',Parm[Pclb])+1,Length(Parm[Pclb])));
  113.             End;
  114.           End;
  115.           If Pos('C',Parm[Pclb]) > 0 Then
  116.           Begin
  117.             Cpos := Pclb;
  118.             If Pos('C',Parm[Pclb]) > 1 Then
  119.             Begin
  120.               CTimer := MyVal(Copy(Parm[Pclb],1,Pos('C',Parm[Pclb])-1));
  121.             End;
  122.             If Length(Parm[Pclb]) > Pos('C',Parm[Pclb]) Then
  123.             Begin
  124.               CExit := MyVal(Copy(Parm[Pclb],Pos('C',Parm[Pclb])+1,Length(Parm[Pclb])));
  125.             End;
  126.           End;
  127.           If Pos('N',Parm[Pclb]) > 0 Then
  128.           Begin
  129.             Npos := Pclb;
  130.             If Pos('N',Parm[Pclb]) > 1 Then
  131.             Begin
  132.               NTimer := MyVal(Copy(Parm[Pclb],1,Pos('N',Parm[Pclb])-1));
  133.             End;
  134.             If Length(Parm[Pclb]) > Pos('N',Parm[Pclb]) Then
  135.             Begin
  136.               NExit := MyVal(Copy(Parm[Pclb],Pos('N',Parm[Pclb])+1,Length(Parm[Pclb])));
  137.             End;
  138.           End;
  139.           If Pos('S',Parm[Pclb]) > 0 Then
  140.           Begin
  141.             Spos := Pclb;
  142.             If Pos('S',Parm[Pclb]) > 1 Then
  143.             Begin
  144.               STimer := MyVal(Copy(Parm[Pclb],1,Pos('S',Parm[Pclb])-1));
  145.             End;
  146.             If Length(Parm[Pclb]) > Pos('S',Parm[Pclb]) Then
  147.             Begin
  148.               SExit := MyVal(Copy(Parm[Pclb],Pos('S',Parm[Pclb])+1,Length(Parm[Pclb])));
  149.             End;
  150.           End;
  151.         End;
  152.       End;
  153.     End;
  154.   End;
  155. {========================================================================}
  156. Procedure CheckKeys;
  157.   Begin
  158.     CapsLock := False; NumLock := False; ScrollLock := False;
  159.     Msr.Ah := $12;
  160.     Intr($16,Msr);
  161.     If (Msr.Al And 16) = 16 Then ScrollLock := True;
  162.     If (Msr.Al And 32) = 32 Then NumLock := True;
  163.     If (Msr.Al And 64) = 64 Then CapsLock := True;
  164.   End;
  165. {========================================================================}
  166. Procedure AllExitCheck;
  167.   Begin
  168.     If ATimer = 0 Then
  169.     Begin
  170.       WriteLn('Immediate - Exit('+MyStr(AExit)+')');
  171.       WriteLn;
  172.       Halt(AExit);
  173.     End
  174.     Else
  175.     Begin
  176.       Write('Seconds before timeout - ');
  177.       KeyReturn := KeyTimeOut(ATimer);
  178.       If KeyReturn > 0 Then
  179.       Begin
  180.         If AExit = 0 Then AExit := KeyReturn;
  181.         WriteLn('Exit('+MyStr(AExit)+')');
  182.         WriteLn;
  183.         Halt(AExit);
  184.       End
  185.       Else WriteLn('0');
  186.     End;
  187.   End;
  188. {========================================================================}
  189. Procedure CapsExitCheck;
  190.   Begin
  191.     If CapsLock Then
  192.     Begin
  193.       If CTimer = 0 Then
  194.       Begin
  195.         WriteLn('Caps Lock : Immediate - Exit('+MyStr(CExit)+')');
  196.         WriteLn;
  197.         Halt(CExit);
  198.       End
  199.       Else
  200.       Begin
  201.         Write('Caps Lock : Seconds before timeout - ');
  202.         KeyReturn := KeyTimeOut(CTimer);
  203.         If KeyReturn > 0 Then
  204.         Begin
  205.           If CExit = 0 Then CExit := KeyReturn;
  206.           WriteLn('Exit('+MyStr(CExit)+')');
  207.           WriteLn;
  208.           Halt(CExit);
  209.         End
  210.         Else WriteLn('0');
  211.       End;
  212.     End;
  213.   End;
  214. {========================================================================}
  215. Procedure NumExitCheck;
  216.   Begin
  217.     If NumLock Then
  218.     Begin
  219.       If NTimer = 0 Then
  220.       Begin
  221.         WriteLn('Num Lock : Immediate - Exit('+MyStr(NExit)+')');
  222.         WriteLn;
  223.         Halt(NExit);
  224.       End
  225.       Else
  226.       Begin
  227.         Write('Num Lock : Seconds before timeout - ');
  228.         KeyReturn := KeyTimeOut(NTimer);
  229.         If KeyReturn > 0 Then
  230.         Begin
  231.           If NExit = 0 Then NExit := KeyReturn;
  232.           WriteLn('Exit('+MyStr(NExit)+')');
  233.           WriteLn;
  234.           Halt(NExit);
  235.         End
  236.         Else WriteLn('0');
  237.       End;
  238.     End;
  239.   End;
  240. {========================================================================}
  241. Procedure ScrollExitCheck;
  242.   Begin
  243.     If ScrollLock Then
  244.     Begin
  245.       If STimer = 0 Then
  246.       Begin
  247.         WriteLn('Scroll Lock : Immediate - Exit('+MyStr(SExit)+')');
  248.         WriteLn;
  249.         Halt(SExit);
  250.       End
  251.       Else
  252.       Begin
  253.         Write('Scroll Lock : Seconds before timeout - ');
  254.         KeyReturn := KeyTimeOut(STimer);
  255.         If KeyReturn > 0 Then
  256.         Begin
  257.           If SExit = 0 Then SExit := KeyReturn;
  258.           WriteLn('Exit('+MyStr(SExit)+')');
  259.           WriteLn;
  260.           Halt(SExit);
  261.         End
  262.         Else WriteLn('0');
  263.       End;
  264.     End;
  265.   End;
  266. {========================================================================}
  267. Begin
  268.   WriteLn(Pgmid);
  269.   ParseCommandLine;
  270.   CheckKeys;
  271.   For Count := 1 to ParamCount Do
  272.   Begin
  273.     If APos = Count Then AllExitCheck;
  274.     If CPos = Count Then CapsExitCheck;
  275.     If NPos = Count Then NumExitCheck;
  276.     If SPos = Count Then ScrollExitCheck;
  277.   End;
  278.   WriteLn('Exit(0)');
  279.   WriteLn;
  280.   Halt(0);
  281. End.
  282. {========================================================================}
  283.